perm filename CODE[C,JRA] blob
sn#014368 filedate 1972-11-22 generic text, type T, neo UTF8
00100 (IF-NEEDED C-F-AND (CODE-FOR (AND . !'L) !<CODE)
00200 (CSETQ CODE NIL)
00300 (FOR-EACH-ELEMENT G L
00400 (CSETQ CODE (CONS !"(PROG (ACHIEVE ,G) (PROTECT ,G)) CODE)))
00500 (CSETQ CODE !"(PROG "AUX" ((PROTECTEDS PROTECTEDS))
00600 !@(REVERSE ,CODE)))
00700 (PUTP CODE 'UNORDERED 'CHOICE)
00800 (NOTE))
00900
01000 (IF-NEEDED C-F-NOT-EXISTS
01100 (CODE-FOR (NOT (EXISTS !>V !'G))
01200 (PROG "AUX" !,V
01300 :LP (COND ((FIND !,V !<G1) (MAKE (NOT !<G2)) (GO 'LP)))
01400 'OK))
01500 (CSETQ G1 (PREFIX '/!/; V G)
01600 G2 (PREFIX '/!/, V G))
01700 (NOTE))
01800
01900 (IF-NEEDED C-F-EXISTS (CODE-FOR (EXISTS !>V !'G) !<CODE)
02000 "AUX"((G1 (PREFIX '/!/; V G)))
02100 (CSETQ CODE
02200 !"(PROG "AUX" ,V
02300 !@(COND ((EQ (CAR ,REASON) 'ACHIEVE)
02400 !"((IF ,G1 (RETURN 'ALREADY-TRUE)))))
02500 (CHOOSE ,G1)
02600 (MAKE @(PREFIX '/!/, ,V ,G))))
02700 (NOTE))
02800
02900 (IF-NEEDED C-F-WHERE (CODE-FOR (WHERE !'G !'Q) !<CODE)
03000 (CSETQ CODE (LIST (CAR REASON) G))
03100 (NOTE))
03200
03300 (IF-NEEDED C-F-NOT-WHERE (CODE-FOR (NOT (WHERE !'G !'Q)) !<CODE)
03400 (CSETQ CODE (LIST (CAR REASON) (LIST 'NOT G)))
03500 (NOTE))
03600
03700 (IF-NEEDED M-O-NOT (MEANING-OF (NOT !'G) !<MEAN)
03800 (COND ((TRY-NEXT (FETCHM !"(MEANING-OF ,G !>MEAN)))
03900 (CSETQ MEAN (LIST 'NOT MEAN))
04000 (NOTE))))